home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / System source / Mod < prev    next >
Text File  |  1993-06-07  |  6KB  |  166 lines
  1. \ Module - support for separately compiled modules in Yerk
  2. \ 12/04/84  CBD Version 1
  3. \ 10/22/85  cdn Echo during module load
  4. \ 12/20/85  cdn Reuse target BIN file- so as not to wrestle file from folder
  5. \  7/11/86  cdn Modify flagging technique in BldBits for faster run time
  6. \  7/26/86  cdn Added ^last word defined in module as first 4 bytes
  7. \  8/31/88    rfl ***WARNING***
  8. \                The code to become a module must clear all data areas it uses.
  9. \                If it doesn't, the second pass will have differing bytes
  10. \                than the first pass and bldbits will think they are
  11. \                relocatable addresses!
  12. \ 5/06/93    rfl added 'immediates' to handle marking immediate imports
  13. \ 6/04/93    rfl    sfind now doesn't map to uppercase, as advertised in glossary
  14. \                screate modified for source documentation...screate and sfine
  15. \                moved to 'file' ... 'module' saves doc state and sets to -doc
  16.  
  17. Decimal
  18.  
  19. \ use: You must define the imports for a module in the resident
  20. \ portion of your application with the statement:
  21. \     FROM moduleName IMPORT{ imp0 ... impN }
  22. \ This will create a module definition for filename "moduleName"
  23. \ and import definitions for all imported names.
  24. \ Later, you must build the module with the statement
  25. \    module "moduleName"
  26. \ This will look up the mod def for moduleName, and generate a
  27. \ relocatable module from its source file.
  28. \ After the module is built, any reference to one of the imported names
  29. \ will cause the module to be loaded. Imported names are local to
  30. \ the vocabulary that they are defined in.
  31.  
  32. \ Define names to be imported from module - FROM modName IMPORT{ ... }
  33. \ ( -- modDefCfa )
  34. : From   modDef latest Name>  ;
  35.  
  36. \ imp def data consists of |mod0cfa|offs|
  37. \ code to execute for an import def
  38. 1 codefields
  39.     Do..  dup  4+ w@        \ @IMP
  40.         swap @ 4+ execute    \ exec 1cfa of MODULE def
  41.     ..End
  42.  
  43. 2drop
  44. Constant impCfa
  45.  
  46. \ build an import definition for the name at HERE
  47. : ,import { imp# modCfa -- }
  48.     here 1 and IF 0 c, THEN
  49.     createHdr -4 allot impCfa ,    \ create link, cfa
  50.     modCfa , imp# 4* 4+ w, latest modCfa 16 + ! ;    \ last import link
  51.  
  52. \ parse the export defs for module
  53. : Import{   { modCfa -- }   0
  54.     BEGIN  bl word  firstChr ascii } <>
  55.     WHILE  dup modCfa  ,import  1+    \ build import defs
  56.     REPEAT  modCfa  20 + w!  ;        \ save # of imports
  57.  
  58. 0 value  modStart    \ beginning addr of module during build
  59. 0 value  moduleCfa    \ cfa of module def during build
  60. 0 value  cleanMod    \ true if clean compile
  61.  
  62. \ clear object area of bitmap and create the indexed hdr
  63. : clearBits { addr len -- }    \ len is of overlay bytes
  64.     len bitsLen -> len  addr len  erase
  65.     ' bitMap addr ! len 8 - addr 6 + w! 1 addr 4+ w! ;
  66.  
  67. \ Build a bitmap containing relocation flags for all words in an application.
  68. : bldBits { base len \ hibase inc -- }
  69.     base len + -> hibase
  70.     base len 2* + 4+ -> bits
  71.     bits 4- len clearBits
  72.     len 0 DO
  73.         2 -> inc
  74.         base i+ w@  hiBase i+ w@ <>
  75.         IF i dup 1+ len >=
  76.             IF   1-
  77.             ELSE base i+ 2+ w@  hiBase i+ 2+ w@ <>
  78.                 IF 4 -> inc ELSE 1- THEN
  79.             THEN
  80.             2/ bits set: bitmap
  81.         THEN
  82.     inc +LOOP ;
  83.  
  84. \ build bitmap for overlay starting at word in stream
  85. : bldOvl { loBase hiBase \ len ^parms -- base totalLen }
  86.     hiBase loBase - -> len  loBase len bldBits
  87.     type# 185 ( module code size: ) len . ." bytes " cr
  88.     bits limit: [ bits ] + 4+ -> ^parms
  89.     len ^Parms w!  hiBase ^parms 2+ !            \ build parms area
  90.     hibase ^parms hiBase - 6 ( parmsLen ) +  ;    ( -- base len )
  91.  
  92. \ Save binary overlay for an application that was loaded twice
  93. : saveBin { loBase hiBase -- }
  94.     loBase hiBase bldovl    ( base len )
  95.     create: fFcb ?error 138
  96.     latest pfa lfa                \ find link field of first word in module
  97.     BEGIN @ pfa lfa dup @ hiBase < UNTIL
  98.     dup @ swap 0 over !            \ ( link addr )  zero out link field
  99.     2swap write: fFcb >R ! R> ?error 140
  100.     binType saveSig set: fFcb    \ set creator, type
  101.     close: fFcb drop ;
  102.  
  103. \ reserve space for export vectors and save modStart
  104. ( #exports -- )
  105. : ,Exports   here -> modStart  4* 4+ reserve ;
  106.  
  107. \ initialize the export vectors for module just compiled
  108. : !exports { modCfa \ thisImp -- }
  109.     modCfa 16 + @  -> thisImp    \ link to nfa of last import
  110.     BEGIN thisImp n>count sFind 0= ?error 143
  111.         drop dup nfa thisImp =
  112.         IF cr thisImp .name msg# 144 0 -> cleanMod
  113.         ELSE  dup nfa c@ thisImp c!    \ copy name flags into import definition
  114.             cfa thisImp name>
  115.             8+ w@ modStart + !    \ store export cfa
  116.         THEN    thisImp name> >link @ dup -> thisImp  Name> modCfa =
  117.     UNTIL ;        \ loop until back to module def
  118.  
  119. \ module builder - loads module source twice, relocates it, saves to disk
  120. \ use: mBuild "modFile"
  121. : Module { \ loMod hiMod mecho docState -- } docs -> docstate -docs
  122.     1 -> cleanMod  0 -> moduleCFA
  123.     " TASK" sCreate
  124.     $ 10000 here - 0 max allot    \ 64K compile boundry
  125.     new: loadFile setName: topFile
  126.     cr type# 176 ( Compiling module: ) getName: topFile type cr
  127.     Here -> loMod interpret: topFile    \ *** FIRST PASS
  128.     loMod @ latest or loMod !    \ mark last def (hi byte is flags)
  129.     cleanMod 0= ?error 145
  130.     moduleCfa >name n>count binName name: fFcb    \ set name of binary file
  131.     decho -> mecho -echo        \ preserve load echo flag
  132.     cr getName: fFcb type type# 177 ( Second pass…) cr
  133.     topFile 80 erase  topFile set-file    \ fresh fcb (for HFS compatability)
  134.     here -> hiMod interpret: topFile    \ *** SECOND PASS
  135.     hiMod @ latest or hiMod !    \ mark last def (hi byte is flags)
  136.     remove: loadfile
  137.     mecho -> decho                \ restore load echo flag
  138.     hiMod loMod - 0= ?error 146
  139.     loMod hiMod saveBin
  140.     ." Binary module " getName: fFcb type ."  successfully saved " cr
  141.     moduleCFA 12 + dispose        \ purge old module from memory
  142.     " TASK" sFind  0 -> cleanMod
  143.     IF drop dup nfa -> dp lfa @ current ! THEN docState -> docs ;
  144.  
  145. \ begin a module source definition
  146. : :Module
  147.     @pfa cfa dup @ modCode <> ?error 147
  148.     dup -> moduleCfa cleanMod
  149.     0= ?error 164 cr    \ Use "Module" loader for modules
  150.     20 + w@ dup . type# 178 ( export entries ) cr
  151.     ,Exports   ;    \ build export vectors
  152.  
  153. \ Cause the module to remain locked after execution terminates
  154. : Locked 1 modStart c! ;
  155.  
  156. \ end a module source definition
  157. : ;Module
  158.     moduleCfa  dup 0= ?error 148
  159.     !exports  ;
  160.  
  161. \ if any of the imported words are defined in the module as immediate,
  162. \   you should move all of them to the last of the import list and
  163. \   then add n immediates to mark them as such.
  164. : immediates { num \ addr -- } latest -> addr
  165.     num 0 DO addr 64 toggle addr 1 traverse 1+ @ -> addr LOOP ;
  166.